home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 March - Disc 1 / Macworld (1999-03) (Disk 1).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / SystemCode / clickUtils.tcl < prev    next >
Encoding:
Text File  |  1998-12-16  |  6.8 KB  |  282 lines  |  [TEXT/ALFA]
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  # 
  4.  #  FILE: "clickUtils.tcl"
  5.  #                                    created: 11/2/96 {9:17:08 am} 
  6.  #                                last update: 16/12/1998 {1:57:47 pm} 
  7.  ##
  8.  
  9. # ◊◊◊◊ Option click in titlebar ◊◊◊◊ #
  10.  
  11. # Now doesn't add anything extra for windows which are not saved to disk.
  12. # To deal with shells and other similar windows. More general than only doing this for
  13. # shell mode.
  14. proc optClickTB_List {} {
  15.     global minItemsInTitlePopup
  16.     set lines [mode::proc OptionTitlebar]
  17.     if {[llength $lines] < $minItemsInTitlePopup} {
  18.     return [::OptionTitlebar $lines]
  19.     } else {
  20.     return $lines
  21.     }
  22. }
  23.  
  24. proc ::OptionTitlebar {{lines ""}} {
  25.     if {[file exists [stripNameCount [win::Current]]]} {
  26.     pushd [file dirname [win::Current]]
  27.     if {[llength $lines]} {
  28.         eval lappend lines "-" [glob -nocomplain *]
  29.     } else {
  30.         set lines [glob -nocomplain *]
  31.     }
  32.     popd
  33.     }
  34.     return $lines
  35. }
  36.  
  37. ## 
  38.  # -------------------------------------------------------------------------
  39.  #     
  40.  # "optClickTB_Pick" --
  41.  #    
  42.  #    Called when    you    select an item from    the    option-click pop-up.  Call a
  43.  #    mode-specific procedure    if possible, else assume it's a    file in    the    
  44.  #    same directory as the current window, and open it.  If the mode specific
  45.  #    procedure ends in an error, we use the default version.
  46.  # -------------------------------------------------------------------------
  47.  ##
  48. proc optClickTB_Pick {item} {
  49.     if {[catch {mode::proc OptionTitlebarSelect $item}]} {
  50.     ::OptionTitlebarSelect $item
  51.     }
  52. }
  53.  
  54. proc ::OptionTitlebarSelect {item} {
  55.     if {[file isdirectory [file join [file dirname [win::Current]] $item]]} {
  56.     file::showInFinder [file join [file dirname [win::Current]] $item]
  57.     } else {
  58.     file::tryToOpen $item
  59.     }
  60. }
  61.  
  62. # ◊◊◊◊ Command click on window title ◊◊◊◊ #
  63.  
  64. # Called from Alpha when titlebar "title" menu selected (command-mouse).
  65. proc getTitleBarPath {} {
  66.     global fetched
  67.     
  68.     set f [win::Current]
  69.     if {[info exists fetched($f)]} {
  70.     set nm "[lindex $fetched($f) 0]/[lindex $fetched($f) 1]/[file tail $f]"
  71.     regsub -all {//} $nm {/} nm
  72.     regsub -all {/} $nm {:} nm
  73.     return $nm
  74.     } else {
  75.     return $f
  76.     }
  77. }
  78.  
  79. proc titlebar {name} {
  80.     global fetched
  81.     
  82.     if {[info exists fetched([win::Current])]} {
  83.     set specs $fetched([win::Current])
  84.     # add type of link to end of specs for backwards compatibility
  85.     if {[lindex $specs 4] == ""} {
  86.         lappend specs "ftp"
  87.         set fetched([win::Current]) $specs
  88.     }
  89.     if {$name == [getTitleBarPath]} {
  90.         set user ""
  91.         if {[key::shiftPressed]} {
  92.         set user [lindex $specs 2]
  93.         if {[key::controlPressed]} {
  94.             append user ":" [lindex $specs 3]
  95.         } 
  96.         append user "@"
  97.         }
  98.         putScrap "<[lindex $specs 4]://${user}[lindex $specs 0]/[lindex $specs 1]/[file tail $name]>"
  99.         message "Copied URL of '[file tail $name]' to the Clipboard."        
  100.     } else {
  101.         regexp {[^:]*:(.*)} $name dummy dir
  102.         if {[regexp {:} $dir]} {
  103.         regexp {(.*):([^:]*)} $dir dummy dir fname
  104.         } else {
  105.         set fname ""
  106.         }
  107.         regsub -all {:} $dir {/} dir
  108.         eval ftpBrowse [list [lindex $specs 0] $dir] [lrange $specs 2 4] [list $fname]
  109.     }
  110.     } else {
  111.     if {$name == [win::Current]} {
  112.         if {[key::shiftPressed]} {
  113.         file::showInFinder
  114.         } else {
  115.         putScrap $name
  116.         message "Copied full path of '[file tail $name]' to the Clipboard."
  117.         }
  118.     } else {
  119.         if {[key::shiftPressed]} {
  120.         openFolder $name
  121.         } else {
  122.         findFile $name
  123.         }
  124.     }
  125.     }
  126. }
  127.  
  128. # ◊◊◊◊ Command Double Click ◊◊◊◊ #
  129.  
  130. proc cmdDoubleClick {{from -1} {to -1} {shift 0} {option 0} {control 0}} {
  131.     global mode
  132.     
  133.     if {[expandURL] != ""} {
  134.     sendUrl [getSelect]
  135.     } else {
  136.     if {$from < 0} {
  137.         set from [getPos]
  138.         set to [selEnd]
  139.         if {[pos::compare $from == $to]} {
  140.         hiliteWord
  141.         set from [getPos]
  142.         set to [selEnd]
  143.         }
  144.     }
  145.     if {[set proc [mode::getProc DblClick]] != ""} {
  146.         if {[llength [info args $proc]] == 2} {
  147.         $proc $from $to
  148.         } else {
  149.         $proc $from $to $shift $option $control
  150.         }
  151.     } else {
  152.         message "No docs"
  153.     }
  154.     }    
  155. }
  156.  
  157. proc commandClick {from to url} {
  158.     select $from
  159.     for {set i 0} {$i < 200} {incr i} {}
  160.     select $from $to
  161.     for {set i 0} {$i < 200} {incr i} {}
  162.     select $from
  163.     for {set i 0} {$i < 200} {incr i} {}
  164.     select $from $to
  165.     icURL $url
  166. }    
  167.  
  168. # ◊◊◊◊ URL handling ◊◊◊◊ #
  169.  
  170. # (WTP 7/30/95) Slightly improved 'sendUrl'.
  171. # By accepting a text arg, this can now be used to make sendUrl 
  172. # hypertext links (useful for "mailto" links in documentation, f'rinstance) 
  173. #===============================================================================
  174. set htmlEventSuiteIDs(MOSS) {WWW!}
  175. set htmlEventSuiteIDs(MSIE) {WWW!}
  176.  
  177. proc sendUrl {{text {}}} {
  178.     if {$text == {}} { catch {set text [getSelect]} }
  179.     if {$text == {}} { set text [prompt {URL?} {}] }
  180.     if {[string length $text] == 0} { return }
  181.     
  182.     global htmlEventSuiteIDs browserSig browserSigs
  183.     
  184.     set name [file tail [app::launchAnyOfThese $browserSigs browserSig \
  185.       "Please locate your web browser:"]]
  186.     
  187.     if {![info exists htmlEventSuiteIDs($browserSig)]} {
  188.     alertnote "Can't send URLs to this HTML browser"
  189.     return
  190.     }
  191.     set suite $htmlEventSuiteIDs($browserSig)
  192.     
  193.     AEBuild "'${browserSig}'" $suite {OURL} {----} "“$text”"
  194.     switchTo $name
  195. }
  196.  
  197.  
  198. proc expandURL {} {
  199.     set pos [getPos]
  200.     set beg [lineStart $pos]
  201.     if {[string length [set whe [search -s -n -f 1 -r 1 -i 1 -m 0 -l [nextLineStart $pos] {[a-zA-Z0-9]+://[a-zA-Z/._0-9~-]+} $beg]]]} {
  202.     if {([pos::compare $pos >= [lindex $whe 0]]) \
  203.       && ([pos::compare $pos < [lindex $whe 1]])} {
  204.         eval select $whe
  205.         return $whe
  206.     }
  207.     }
  208. }
  209.  
  210.  
  211.  
  212. # ◊◊◊◊ Printing helpers ◊◊◊◊ #
  213.  
  214. proc printLeftHeader {pg {f ""}} {
  215.     global printHeader printHeaderTime printHeaderFullPath
  216.     
  217.     if {!$printHeader} return
  218.     
  219.     if {$f == ""} {set f [win::Current]}
  220.     if {$printHeaderFullPath} {
  221.     set text $f
  222.     } else {
  223.     set text [file tail $f]
  224.     }
  225.     
  226.     if {$printHeaderTime} {
  227.     append text "      [join [mtime [now] short]]"
  228.     }
  229.     return $text
  230. }
  231.  
  232. proc printRightHeader {pg {f ""}} {
  233.     return "Page $pg"
  234. }
  235.  
  236. proc printAll {} {
  237.     foreach f [winNames -f] {
  238.     print $f
  239.     }
  240. }
  241.  
  242. # ◊◊◊◊ Spellcheck helpers ◊◊◊◊ #
  243.  
  244. #================================================================================
  245. # Excalibur is the only Mac spell-checker that I know of which will handle 
  246. # LaTeX as well as ordinary text.
  247.  
  248.  
  249. proc spellcheckWindow {} {
  250.     global resumeRevert
  251.  
  252.     set name [app::launchFore XCLB]
  253.     
  254.     if {[winDirty]} {
  255.     if {[dialog::yesno "Save '[win::CurrentTail]'?"]} {
  256.         save
  257.     }
  258.     }
  259.     sendOpenEvent noReply [file tail $name] [stripNameCount [win::Current]]
  260.     set resumeRevert 1
  261. }
  262.  
  263. proc spellcheckSelection {} {
  264.     if {[pos::compare [getPos] == [selEnd]]} {
  265.     beep
  266.     message "No selection"
  267.     return;
  268.     }
  269.     set name [app::launchBack XCLB]
  270.     copy
  271.     switchTo $name
  272. }
  273.  
  274.  
  275.  
  276.  
  277.  
  278.  
  279.  
  280.  
  281.  
  282.